home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch14 / Bspline.cls < prev    next >
Text File  |  1999-06-23  |  9KB  |  330 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "Bspline3d"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Private DegreeU As Integer  ' Degree in U direction.
  17. Private DegreeV As Integer  ' Degree in V direction.
  18. Private MaxU As Integer     ' Dimensions of control grid.
  19. Private MaxV As Integer
  20. Private Points() As Point3D ' Control points.
  21.  
  22. ' Holds polylines containing the refined
  23. ' grid to display the surface.
  24. Private Polylines As Collection
  25.  
  26. ' u and v increment parameters.
  27. Private GapU As Single
  28. Private GapV As Single
  29. Private Du As Single
  30. Private Dv As Single
  31.  
  32. ' Display flags.
  33. Private ShowControls As Boolean ' Draw control points?
  34. Private ShowGrid As Boolean     ' Draw control grid?
  35. ' Return the factorial of a number (n!).
  36. Function Factorial(ByVal n As Single) As Single
  37. Dim i As Integer
  38. Dim tot As Single
  39.  
  40.     tot = 1
  41.     For i = 2 To n
  42.         tot = tot * i
  43.     Next i
  44.     Factorial = tot
  45. End Function
  46.  
  47. ' Create polylines to represent the surface.
  48. Public Sub InitializeGrid(ByVal degree_u As Integer, ByVal degree_v As Integer, ByVal gap_u As Single, ByVal gap_v As Single, ByVal d_u As Single, ByVal d_v As Single)
  49. Dim u As Single
  50. Dim V As Single
  51. Dim stopu As Single
  52. Dim stopv As Single
  53. Dim X As Single
  54. Dim Y As Single
  55. Dim Z As Single
  56. Dim x1 As Single
  57. Dim y1 As Single
  58. Dim z1 As Single
  59. Dim pline As Polyline3d
  60.  
  61.     DegreeU = degree_u
  62.     DegreeV = degree_v
  63.     GapU = gap_u
  64.     GapV = gap_v
  65.     Du = d_u
  66.     Dv = d_v
  67.  
  68.     Set Polylines = New Collection
  69.  
  70.     ' Create curves with constant u.
  71.     stopu = MaxU - DegreeU + 2 + GapU / 10
  72.     stopv = MaxV - DegreeV + 2 + Dv / 10
  73.     For u = 0 To stopu Step GapU
  74.         Set pline = New Polyline3d
  75.         Polylines.Add pline
  76.  
  77.         SurfaceValue u, 0, x1, y1, z1
  78.  
  79.         For V = Dv To stopv Step Dv
  80.             SurfaceValue u, V, X, Y, Z
  81.             pline.AddSegment x1, y1, z1, X, Y, Z
  82.             x1 = X
  83.             y1 = Y
  84.             z1 = Z
  85.         Next V
  86.     Next u
  87.  
  88.     ' Create curves with constant v.
  89.     stopv = MaxV - DegreeV + 2 + GapV / 10
  90.     stopu = MaxU - DegreeU + 2 + Du / 10
  91.     For V = 0 To stopv Step GapV
  92.         Set pline = New Polyline3d
  93.         Polylines.Add pline
  94.  
  95.         SurfaceValue 0, V, x1, y1, z1
  96.         For u = Du To stopu Step Du
  97.             SurfaceValue u, V, X, Y, Z
  98.             pline.AddSegment x1, y1, z1, X, Y, Z
  99.             x1 = X
  100.             y1 = Y
  101.             z1 = Z
  102.         Next u
  103.     Next V
  104. End Sub
  105. ' Apply a transformation matrix which may not
  106. ' contain 0, 0, 0, 1 in the last column to the
  107. ' object.
  108. Public Sub ApplyFull(M() As Single)
  109. Dim i As Integer
  110. Dim j As Integer
  111. Dim pline As Polyline3d
  112.  
  113.     ' Apply the matrix to the grid if it exists.
  114.     If Not Polylines Is Nothing Then
  115.         For Each pline In Polylines
  116.             pline.ApplyFull M
  117.         Next pline
  118.     End If
  119.  
  120.     ' Apply the matrix to the control points.
  121.     For i = 0 To MaxU
  122.         For j = 0 To MaxV
  123.             m3ApplyFull Points(i, j).coord, M, Points(i, j).trans
  124.         Next j
  125.     Next i
  126. End Sub
  127. ' Draw the transformed object on a PictureBox.
  128. Public Sub Draw(ByVal pic As PictureBox, Optional R As Variant)
  129. Dim i As Integer
  130. Dim j As Integer
  131. Dim pline As Polyline3d
  132.  
  133.     ' Draw the grid if it exists.
  134.     If Not Polylines Is Nothing Then
  135.         For Each pline In Polylines
  136.             pline.Draw pic, R
  137.         Next pline
  138.     End If
  139.  
  140.     ' Draw the control points if desired.
  141.     If ShowControls Then
  142.         On Error Resume Next
  143.         For i = 0 To MaxU
  144.             For j = 0 To MaxV
  145.                 pic.Line (Points(i, j).trans(1) - 2, Points(i, j).trans(2) - 2)-Step(4, 4), , BF
  146.             Next j
  147.         Next i
  148.     End If
  149.  
  150.     ' Draw the control grid if desired.
  151.     If ShowGrid Then
  152.         On Error Resume Next
  153.         For i = 0 To MaxU
  154.             pic.CurrentX = Points(i, 0).trans(1)
  155.             pic.CurrentY = Points(i, 0).trans(2)
  156.             For j = 1 To MaxV
  157.                 pic.Line -(Points(i, j).trans(1), Points(i, j).trans(2))
  158.             Next j
  159.         Next i
  160.         For j = 0 To MaxV
  161.             pic.CurrentX = Points(0, j).trans(1)
  162.             pic.CurrentY = Points(0, j).trans(2)
  163.             For i = 1 To MaxU
  164.                 pic.Line -(Points(i, j).trans(1), Points(i, j).trans(2))
  165.             Next i
  166.         Next j
  167.     End If
  168. End Sub
  169.  
  170. ' Return a value indicating whether we
  171. ' are drawing the control grid.
  172. Property Get DrawGrid() As Boolean
  173.     DrawGrid = ShowGrid
  174. End Property
  175.  
  176. ' Return a value indicating whether we
  177. ' are drawing the control points.
  178. Property Get DrawControls() As Boolean
  179.     DrawControls = ShowControls
  180. End Property
  181.  
  182.  
  183. ' Set the value indicating whether we
  184. ' are drawing the control grid.
  185. Property Let DrawGrid(ByVal new_value As Boolean)
  186.     ShowGrid = new_value
  187. End Property
  188. ' Set the value indicating whether we
  189. ' are drawing the control points.
  190. Property Let DrawControls(ByVal new_value As Boolean)
  191.     ShowControls = new_value
  192. End Property
  193.  
  194.  
  195.  
  196.  
  197. ' Apply a transformation matrix to the object.
  198. Public Sub Apply(M() As Single)
  199. Dim i As Integer
  200. Dim j As Integer
  201. Dim pline As Polyline3d
  202.  
  203.     ' Apply the matrix to the polylines.
  204.     If Not Polylines Is Nothing Then
  205.         For Each pline In Polylines
  206.             pline.Apply M
  207.         Next pline
  208.     End If
  209.  
  210.     ' Apply the matrix to the control points.
  211.     For i = 0 To MaxU
  212.         For j = 0 To MaxV
  213.             m3Apply Points(i, j).coord, M, Points(i, j).trans
  214.         Next j
  215.     Next i
  216. End Sub
  217.  
  218.  
  219.  
  220.  
  221.  
  222. ' Set MaxU and MaxV and allocate room for the
  223. ' control points.
  224. Public Sub SetBounds(ByVal NumX As Integer, ByVal NumZ As Integer)
  225.     MaxU = NumX - 1
  226.     MaxV = NumZ - 1
  227.     ReDim Points(0 To NumX, 0 To NumZ)
  228. End Sub
  229.  
  230. ' Set the value for a control point.
  231. Public Sub SetControlPoint(ByVal i As Integer, ByVal j As Integer, ByVal X As Single, ByVal Y As Single, ByVal Z As Single)
  232.     Points(i - 1, j - 1).coord(1) = X
  233.     Points(i - 1, j - 1).coord(2) = Y
  234.     Points(i - 1, j - 1).coord(3) = Z
  235.     Points(i - 1, j - 1).coord(4) = 1
  236. End Sub
  237. ' Return the (X, Y, Z) coordinates of the
  238. ' B-spline surface for these u and v values.
  239. Private Sub SurfaceValue(ByVal u As Single, ByVal V As Single, ByRef X As Single, ByRef Y As Single, ByRef Z As Single)
  240. Dim P As Integer
  241. Dim i As Integer
  242. Dim j As Integer
  243. Dim pt As Point3D
  244. Dim Ni As Single
  245. Dim Nj As Single
  246.  
  247.     For i = 0 To MaxU
  248.         ' Compute Ni.
  249.         Ni = NValue(i, MaxU, DegreeU, DegreeU, u)
  250.  
  251.         For j = 0 To MaxV
  252.             ' Compute Nj.
  253.             Nj = NValue(j, MaxV, DegreeV, DegreeV, V)
  254.             
  255.             ' Add to the coordinates.
  256.             For P = 1 To 3
  257.                 pt.coord(P) = pt.coord(P) + _
  258.                     Points(i, j).coord(P) * _
  259.                     Ni * Nj
  260.             Next P
  261.         Next j
  262.     Next i
  263.     
  264.     ' Prepare the output.
  265.     X = pt.coord(1)
  266.     Y = pt.coord(2)
  267.     Z = pt.coord(3)
  268. End Sub
  269.  
  270. ' Return the value of N.
  271. Private Function NValue(ByVal i As Integer, ByVal max As Integer, ByVal degree As Integer, ByVal max_degree As Integer, ByVal u As Single) As Single
  272. Dim denom As Single
  273. Dim v1 As Single
  274. Dim v2 As Single
  275.  
  276.     If degree = 1 Then
  277.         If Knot(i, max, max_degree) <= u And _
  278.          u < Knot(i + 1, max, max_degree) Then
  279.             NValue = 1
  280.         Else
  281.             NValue = 0
  282.         End If
  283.         
  284.         ' Recall that:
  285.         '   Ni,1(u) = 0     if ti <= u < ti+1
  286.         '             1     otherwise
  287.         ' The following test handles u = tmax.
  288.         If i = max And _
  289.             Knot(i, max, max_degree) <= u And _
  290.             u <= Knot(i + 1, max, max_degree) + 0.001 Then
  291.                 NValue = 1
  292.         End If
  293.         Exit Function
  294.     End If
  295.     
  296.     denom = Knot(i + degree - 1, max, max_degree) - _
  297.         Knot(i, max, max_degree)
  298.     If denom = 0 Then
  299.         v1 = 0
  300.     Else
  301.         v1 = (u - Knot(i, max, max_degree)) * _
  302.             NValue(i, max, degree - 1, max_degree, u) / _
  303.             denom
  304.     End If
  305.  
  306.     denom = Knot(i + degree, max, max_degree) - _
  307.         Knot(i + 1, max, max_degree)
  308.     If denom = 0 Then
  309.         v2 = 0
  310.     Else
  311.         v2 = (Knot(i + degree, max, max_degree) - u) * _
  312.             NValue(i + 1, max, degree - 1, max_degree, u) / _
  313.             denom
  314.     End If
  315.  
  316.     NValue = v1 + v2
  317. End Function
  318.  
  319. ' Return a B-spline knot value.
  320. Private Function Knot(ByVal i As Integer, ByVal max As Integer, ByVal degree As Integer) As Integer
  321.     If i < degree Then
  322.         Knot = 0
  323.     ElseIf i <= max Then
  324.         Knot = i - degree + 1
  325.     Else
  326.         Knot = max - degree + 2
  327.     End If
  328. End Function
  329.  
  330.